Option Strict Off
Option Explicit On
Module VideoStreaming
	'Thes subroutines setup video streaming from DirectShow (DirectX) device directly to a picturebox hardware overlay, and also if required then sends it to a picturebox picture
	'Important this routine requires The installation of fsfwrap.dll and capstill.dll inj system32 directory. It also then
	'requires them to be linked (ticked on) in top menu  - project - references. In addition activate "Active movie Control type library"
	Dim gCapStill As CAPSTILLLib.VBGrabber
	Dim dx_MediaControl As QuartzTypeLib.IMediaControl
	
	Public Sub StopVideoStreaming()
		dx_MediaControl.Stop() 'Stop the "graph". This means end previewing of camera to small window.
	End Sub
    Public Sub CopyCamToPic(ByVal DestPicture As PictureBox) 'This copies directly from the video source / camera to a picturebox
        Dim hMemDc As Integer 'The handle to the created memort DC, used as the source handle for the blit command
        Dim hbm As Integer

        Dim DestGraph As Graphics = DestPicture.CreateGraphics
        Dim DestHDC As IntPtr = DestGraph.GetHdc

        Dim CamGraph As Graphics = frmAveraging.picCamera.CreateGraphics
        Dim CamHDC As IntPtr = CamGraph.GetHdc


        Dim bma As CAPSTILLLib.IBitmapAccess
        bma = gCapStill.CapToMem 'Im assuming this is a function that copies an image from the camera to memory
        hbm = bma.DIBSection 'Create a bitmap section, bitmap headers etc. in memory using the values of the captured image
        'UPGRADE_ISSUE: PictureBox property picCamera.hdc was not upgraded. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="CC4C7EC0-C903-48FC-ACCC-81861D12DA4A"'
        'Result = SelectObject(frmAveraging.picCamera.hdc, hbm) 'Copy image from bma structure into the memory dc
        Result = SelectObject(CamHDC, hbm) 'Copy image from bma structure into the memory dc

        'UPGRADE_ISSUE: PictureBox property picCamera.hdc was not upgraded. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="CC4C7EC0-C903-48FC-ACCC-81861D12DA4A"'
        'BitBlt(DestPicture, 0, 0, bma.Width, bma.Height, frmAveraging.picCamera.hdc, 0, 0, &HCC0020) 'Blit the image from the DC to a picturebox
        BitBlt(DestHDC, 0, 0, bma.Width, bma.Height, CamHDC, 0, 0, &HCC0020) 'Blit the image from the DC to a picturebox

        DestGraph.ReleaseHdc(DestHDC)
        CamGraph.ReleaseHdc(CamHDC)
        DestGraph.Dispose()
        CamGraph.Dispose()


        '  DeleteDC hMemDc                                                               'Delete the memory DC
    End Sub
	Public Sub CopyCamToPic1() 'This copies directly from the video source / camera to a picturebox
		Dim bma As CAPSTILLLib.IBitmapAccess
		bma = gCapStill.CapToMem 'Im assuming this is a function that copies an image from the camera to memory
	End Sub
	
	Public Sub SetVideoStream(ByRef hwndDestWind As Integer, ByRef SourceDevice As String, ByRef UseSavedData As Boolean)
		'This subroutine sets up video streaming from a DirectShow (DirectX) device such as a camera to a picturebox. The image actually hardware overlays the picture box and is
		'not the .picture of the picturebox. It makes use of two .dll libraries fsfwrap.dll and capstill.dll. The subroutine needs supplying with the handle to the picturebox
		'the video is to be streamed to, ie picCamera.hwnd, picture1.hwnd etc. and the source device name that has been selected
		
		' make a new graph
		Dim dx_VideoWindow As QuartzTypeLib.IVideoWindow
		Dim gRegFilters As Object
		Dim iVideo As QuartzTypeLib.IBasicVideo2 'Enables extraction of various data from the video stream , ie height and width etc. check MSDN website for IBasicVideo2
		'UPGRADE_NOTE: Object dx_MediaControl may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6E35BFF6-CD74-4B09-9689-3E1A43DF8969"'
		dx_MediaControl = Nothing 'Empty the control if it has been used before
		'UPGRADE_NOTE: Object gCapStill may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6E35BFF6-CD74-4B09-9689-3E1A43DF8969"'
		gCapStill = Nothing 'Empty the control if it has been used before
		dx_MediaControl = New QuartzTypeLib.FilgraphManager
		gRegFilters = dx_MediaControl.RegFilterCollection
		iVideo = dx_MediaControl 'attach the IBasicVideo2 object to the media control
		
		' add the grabber including vb wrapper and default props
		'UPGRADE_NOTE: filter was upgraded to filter_Renamed. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="A9E4979A-37FA-4718-9994-97DD76ED70A7"'
		Dim filter_Renamed As QuartzTypeLib.IRegFilterInfo
		Dim fGrab As QuartzTypeLib.IFilterInfo
		For	Each filter_Renamed In gRegFilters
			If filter_Renamed.Name = "SampleGrabber" Then
				filter_Renamed.filter(fGrab)
				
				' wrap this filter in the capstill vb wrapper
				' also sets rgb-24 media type and other properties
				gCapStill = New CAPSTILLLib.VBGrabber
				'UPGRADE_WARNING: Couldn't resolve default property of object gCapStill.FilterInfo. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
				gCapStill.FilterInfo = fGrab
				Exit For
			End If
		Next filter_Renamed
		
		' add the selected source filter
		Dim fSrc As QuartzTypeLib.IFilterInfo
		For	Each filter_Renamed In gRegFilters 'Go through all the fiters (devices) until the one selected is found
			If filter_Renamed.Name = SourceDevice Then 'Check if the filter from the list box "ie the selected source device" is found
				filter_Renamed.filter(fSrc)
				Exit For
			End If
		Next filter_Renamed
		
		' check for crossbar and select decoder
		Dim xbar As FSFWRAPLib.CrossbarInfo
		xbar = New FSFWRAPLib.CrossbarInfo
		On Error GoTo NoXBar
		xbar.SetFilter(fSrc)
		
		Dim idx As Integer
		Dim pin As String
		For idx = 0 To xbar.Inputs - 1
			pin = xbar.Name(True, idx)
		Next idx
		
		If xbar.Standard <> FSFWRAPLib.tagAnalogVideoStandard.AnalogVideo_PAL_B Then
			xbar.Standard = FSFWRAPLib.tagAnalogVideoStandard.AnalogVideo_PAL_B
		End If
		
NoXBar: 
		On Error Resume Next
		
		' find first output on src
		Dim pinOut As QuartzTypeLib.IPinInfo
		For	Each pinOut In fSrc.Pins
			If pinOut.Direction = 1 Then
				Exit For
			End If
		Next pinOut
		
		'restore specified file before dlg
		Dim pSC As FSFWRAPLib.StreamConfig
		pSC = New FSFWRAPLib.StreamConfig
		'UPGRADE_WARNING: Couldn't resolve default property of object pSC.pin. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
		pSC.pin = pinOut
		If pSC.SupportsConfig Then
			'UPGRADE_WARNING: Dir has a new behavior. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="9B7D5ADD-D8FE-4819-A36C-6DEDAF088CC7"'
			If Dir(My.Application.Info.DirectoryPath & "\CaptureFormatData.mt") <> "" Then
				
				If UseSavedData = True Then 'Check to see if saved data should be used. Restoring saved data can crash if the device has changed
					pSC.Restore((My.Application.Info.DirectoryPath & "\CaptureFormatData.mt")) 'Load in the saved format
				End If
			End If
		End If
		
		On Error Resume Next
		' show format of output pin before rendering
		Dim ppropOut As FSFWRAPLib.PinPropInfo
		ppropOut = New FSFWRAPLib.PinPropInfo
		'UPGRADE_WARNING: Couldn't resolve default property of object ppropOut.pin. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
		ppropOut.pin = pinOut
		If UseSavedData = False Then 'The configuration data has been saved by setup form, so there is no need to show dialog box again
			ppropOut.ShowPropPage(0) 'This shows the properties window so you can set the resolution , framerate etc.
		End If
		
		' save selected format to file
		If pSC.SupportsConfig Then
			pSC.SaveCurrentFormat((My.Application.Info.DirectoryPath & "\CaptureFormatData.mt"))
		End If
		
		' find first input on grabber and connect
		Dim pinIn As QuartzTypeLib.IPinInfo
		For	Each pinIn In fGrab.Pins
			If pinIn.Direction = 0 Then
				pinOut.Connect(pinIn)
				Exit For
			End If
		Next pinIn
		
		' find grabber output pin and render
		For	Each pinOut In fGrab.Pins
			If pinOut.Direction = 1 Then
				pinOut.Render()
				Exit For
			End If
		Next pinOut
		
		dx_VideoWindow = dx_MediaControl 'Attach the media control to the video window
		dx_VideoWindow.WindowStyle = 0 'Set the window style to none.
		dx_VideoWindow.Top = 0 'Ensure the video window is in the right place over the picturebox
		dx_VideoWindow.Left = 0
		dx_VideoWindow.Owner = hwndDestWind 'Play the video only on the destination
		dx_MediaControl.Run() 'Run the "graph". This means begin previewing.
		
		'UPGRADE_WARNING: Couldn't resolve default property of object iVideo.VideoWidth. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
		CaptureWidth = iVideo.VideoWidth 'Set the  variable that holds the frame width to that of the video stream
		'UPGRADE_WARNING: Couldn't resolve default property of object iVideo.VideoHeight. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
		CaptureHeight = iVideo.VideoHeight 'Set the  variable that holds the frame height to that of the video stream
		
	End Sub
End Module